Libris Britannia 4/science library(b).zip/science library(b)/MEDICAL/2608A.ZIP/GP.ZIP/CHECKSM.SRC

Text File | 1990-11-03 | 5KB | 249 lines

;\|
;CHECKSM.SRC     Translated from CHECKSM.EDT by Roger Mathew's EDT2SRC Ver 4.11
;NEW      03:50:30 AM   7/11/89
DO_DEFINES:
    define(TD|D|10||)
    define(POS|N|1||)
    define(TARGET|N|3||)
    define(AGE|N|6|2|)
    define(REC_DATE|N|4||)
    define(REC_FIELD|A|15||)
    define(FLAG1|N|2||)
    define(TOT_RECORDS|N|8||)
    define(NUMBER|N|8||)
    define(PAGE|N|5||)
    define(SELECT_FROM1|D|10||)
    define(SELECT_THRU1|D|10||)
    define(SELECT_DR|N|1||)
    define(TO_DATE|S|8||)
    define(SORT_BY|N|5||)
    define(PERCENT1|N|6|2|)
    define(PERCENT|N|6|2|)
    define(SORT_BY_TEXT|A|15||)
    define(AGE1|N|6|2|)
    define(MENU_HLDR|A|27||5)
    define(MATCHING_RECS|N|4||)
OPEN_FILES:
    open(RECALLS|||)
    open(PATIENT|||)
    date(TD|G)
    trap(Q|G|EXIT2)
    trap(I|G|EXIT2)
MOUNT_SCR:
    mount(SELECT|S)
    pmsg(" F1 - Help                                                           ESC - Exit "|1|25|N|Y|S|)
START:
    SORT_BY_TEXT = (DATE.OF.BIRTH)
    enter(TO_DATE||||N|N|N|||N)
    SELECT_THRU1 = (TO_DATE-8760)
    SELECT_FROM1 = (TO_DATE-23725)
    SELECT_DR = (1)
    enter(SELECT_FROM1|||START|||||)
    enter(SELECT_THRU1||||||||)
MOUNT_RPT:
    trap(I|G|EXIT2)
    trap(P|S|PRT_TOF)
    mount(NEW|R|P)
FIND_FIRST:
    DATE.OF.BIRTH = (SELECT_FROM1)
    find(G|DATE.OF.BIRTH|NO_RECS|)
PRT_DETAIL:
    if SEX <> ("F") goto FIND_NEXT
    if SELECT_DR <> (0) then if DOCTOR <> (SELECT_DR) goto FIND_NEXT
    if SELECT_FROM1 <> (0) then if DATE.OF.BIRTH < (SELECT_FROM1) goto FIND_NEXT
    if SELECT_THRU1 <> (0) then if DATE.OF.BIRTH > (SELECT_THRU1) goto FINISH
    gosub DO_RELATED
    TOT_RECORDS = (TOT_RECORDS + 1)
FIND_NEXT:
    find(N|PATIENT|FINISH)
    goto PRT_DETAIL
ABORT_RPT:
    pmsg(""|||N|N|D|)
    pmsg(""|||N|N|D|)
    pmsg(">>>>>  Report was terminated before completion  <<<<<"|||N|N|D|)
    pmsg(""|||N|N|D|)
    pmsg(""|||N|N|D|)
FINISH:
    pblnk(2)
    PERCENT1 = (MATCHING_RECS/TOT_RECORDS*100)
    PERCENT = (100-PERCENT1)
    pmsg("        TOTAL RECORDS MATCHING ";TOT_RECORDS|||N|N|D|)
    pmsg("           RECORDS PRINTED; ";MATCHING_RECS|||N|N|D|)
    pmsg("     PERCENTAGE COMPLETED ON TIME ETC: ";PERCENT|||N|N|P|)
    PERCENT = (TOT_RECORDS-MATCHING_RECS)
    TARGET = (TOT_RECORDS*8/10)
    pmsg("YOU HAVE ACHIEVED  ";PERCENT; "  SMEARS WHEN YOUR TARGET IS ";TARGET|||N|N|P|)
    trap(P|D)
    ptof
EXIT:
    TOT_RECORDS = (0)
    MATCHING_RECS = (0)
    SELECT_DR = (SELECT_DR+1)
    if SELECT_DR > (4) then run("recmenu")
    goto MOUNT_RPT
EXIT2:
    run("recmenu")
DO_RELATED:
    COD[1] = ("")
    COD.D[1] = (0)
    REC_FIELD = ("")
    COD.REF = (RECORD.NUMBER)
    find(M|COD.REF|NO_RFIND|N)
    if COD.D[1] > (TO_DATE) do
        {
        if COD[1] = ("HYS") then TOT_RECORDS = (TOT_RECORDS-1)
        if COD[1] = ("REF") do
            {
            REC_FIELD = ("EXCEPTION")
            goto RET_PRINT
            }
        if COD[1] = ("VIR") do
            {
            REC_FIELD = ("EXCEPTION")
            goto RET_PRINT
            }
        POS =loc("M"|COD[1]|1||4)
        if POS > (0) do
            {
            REC_FIELD = ("EXCEPTION")
            TOT_RECORDS = (TOT_RECORDS-1)
            goto RET_PRINT
            }
        }
    if COD.D[1] < (TO_DATE) then gosub CHK_BREAK
    ret
PRT_TOF:
    pset(130|66|60)
    pchr(P|1)
    pfmt(1||||)
    pfmt(3|||N|N|)
    pfmt(5|||N|N|)
    pfmt(6|||N|N|)
    pfmt(7|||N|N|)
    pfmt(3|||N|N|)
    pfmt(2|||N|N|)
    pfmt(3|||N|N|)
    ret
CHK_BREAK:
    NUMBER = (TO_DATE-DATE.OF.BIRTH)
    AGE = (NUMBER/365)
    if COD[1] = ("1") goto BOOSTER
    if COD[1] = ("2") goto BOOSTER
    if COD[1] = ("3") goto BOOSTER
    if COD[1] = ("4") goto BOOSTER
    if COD[1] = ("DONE") ret
    REC_FIELD = ("EXCEPTION")
    goto RET_PRINT
BOOSTER:
    REC_FIELD = ("OVERDUE?")
    if COD.D[1] < (TO_DATE) goto RET_PRINT
    ret
RET_PRINT:
    MATCHING_RECS = (MATCHING_RECS+1)
    pfmt(4|||N|N|)
    ret
NO_RECS:
    goto EXIT
NO_RFIND:
    COD.REF = (0)
    TOT_RECORDS = (TOT_RECORDS+1)
    REC_FIELD = ("NO RECALL???")
    pfmt(4|||N|N|)
    pops
    goto FIND_NEXT
    ret
\STSELECT
                             Selection Screen For
                      SMEAR RESULTS FOR VARIOUS AGE GROUPS
════════════════════════════════════════════════════════════════════════════════

THIS PRINTS OUT DOCTORS SMEARS RESULTS AND EXCEPTIONS TO TODAY

────────────────────────────────────────────────────────────────────────────────

                          Doctor : &           1,2,3,4
    Where DATE.OF.BIRTH   is From: &           Always enter Oldest to
      and DATE.OF.BIRTH   is Thru: &           youngest.
DATE YOU WANT REPORT UP :&












\
SELECT_DR
SELECT_FROM1
SELECT_THRU1
TO_DATE
\
\R NEW
SMEAR EXCEPTION REPORT FOR FOR DOCTOR & ON :&
PATIENT NAME                  ADDRESS                AREA                    LAST SMEAR  CODE  DATE    STATUS      STATUS  AGE
===============================================================================================================================
&                             &                      &                      &           [&   ] &         &                 &
THIS PROGRAM PRINTS OUT ALL SMEAR RESULTS THAT DO NOT APPEAR TO BE UP TO DATE ON :&         AGES 25 -64
IT DOES NOT GIVE A LIST OF RECALLS DUE!!!!!!!! NOR DOES IT INCLUDE "HYS"IN TOTAL AT RISK
THESE SHOULD BE ATTENDED TO TODAY AND NONE SHOULD APPEAR ON THE NEXT PRINTOUT!!!









































\
SELECT_DR
TD
PATIENT.NAME
ADDRESS1
AREA
SM_DATE
COD[1]
COD.D[1]
REC_FIELD
AGE
TO_DATE
\